home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
019
/
tb.arc
/
TB.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1986-08-06
|
17KB
|
593 lines
Program TempBeauty;
{ Original concept and program by Manny Ho - June 1986
Modified by Sukwoon Noh - August 1986 }
Type
Str255 = String[255];
ImageType = Array [1..4096] of Char;
WindImType = Record
X1, Y1, X2, Y2 : Integer;
End;
Var
Copies, TMargin, LMargin, RMargin : Integer;
CopiesStr, TMarginStr, LMarginStr, RMarginStr : String[127];
Choice : Char;
Win : Record
Dim : WindImType;
Depth : Integer;
Stack : Array[1..5] of record
Image : ImageType;
Dim : WindImType;
X, Y : Integer;
End
End;
CrtMode : Byte Absolute $0040:$0049;
CrtWidth : Byte Absolute $0040:$004A;
MonoBuffer : ImageType Absolute $B000:$0000;
ColorBuffer : ImageType Absolute $B800:$0000;
Ch : Char;
Procedure InitWin;
Begin
With Win.Dim do
Begin X1 := 1; Y1 := 1; X2 := CrtWidth; Y2 := 25 End;
Win.Depth := 0
End;
Procedure BoxWin(X1, Y1, X2, Y2 : Integer);
Var
X, Y : Integer;
Begin
Window(1,1,80,25);
GotoXY(X1,Y1); Write(Chr(218));
For X := X1+1 to X2-1 do Write(Chr(196));
Write(Chr(191));
For Y := Y1+1 to Y2-1 do Begin
GotoXY(X1,Y);
Write(Chr(179),' ':X2-X1-1,Chr(179))
End;
GotoXY(X1,Y2); Write(Chr(192));
For X := X1+1 to X2-1 do Write(Chr(196));
Write(Chr(217));
Window(X1+1,Y1+1,X2-1,Y2-1);
GotoXY(1,1);
End;
Procedure MkWin(X1,Y1,X2,Y2 : Integer);
Begin
With Win do Depth := Depth+1;
If Win.Depth > 5 then Begin
Writeln(^G,' Windows nested too deep ');
Halt
End;
If CrtMode = 7 then Win.Stack[Win.Depth].Image := MonoBuffer
Else Win.Stack[Win.Depth].Image := ColorBuffer;
Win.Stack[Win.Depth].Dim := Win.Dim;
Win.Stack[Win.Depth].X := WhereX;
Win.Stack[Win.Depth].Y := WhereY;
BoxWin(X1,Y1,X2,Y2);
Win.Dim.X1 := X1+1;
Win.Dim.Y1 := Y1+1;
Win.Dim.X2 := X2-1;
Win.Dim.Y2 := Y2-1;
End;
Procedure RmWin;
Begin
If CrtMode = 7 then MonoBuffer := Win.Stack[Win.Depth].Image
Else ColorBuffer := Win.Stack[Win.Depth].Image;
With Win do Begin
Dim := Stack[Depth].Dim;
Window(Dim.X1,Dim.Y1,Dim.X2,Dim.Y2);
GotoXY(Stack[Depth].X,Stack[Depth].Y);
Depth := Depth-1;
End
End;
Procedure DoOrientation;
Begin
MkWin(10,3,35,7);
Writeln('A. Portrait');
Writeln('B. Landscape');
Read(Kbd,Choice);
Case Upcase(Choice) of
'A' : Write(Lst,Chr(27),'&l0O');
'B' : Write(Lst,Chr(27),'&l1O');
'C' : Write(^G);
'D' : Write(^G);
'E' : Write(^G);
'F' : Write(^G);
'G' : Write(^G);
'H' : Write(^G);
'I' : Write(^G);
'J' : Write(^G);
'K' : Write(^G);
'L' : Write(^G);
'M' : Write(^G);
'N' : Write(^G);
'O' : Write(^G);
'P' : Write(^G);
'Q' : Write(^G);
'R' : Write(^G);
'S' : Write(^G);
'T' : Write(^G);
'U' : Write(^G);
'V' : Write(^G);
'W' : Write(^G);
'X' : Write(^G);
'Y' : Write(^G);
'Z' : Write(^G);
End;
RmWin;
End;
Procedure DoTypeFace;
Begin
MkWin(10,3,35,14);
Writeln('A. Line Printer');
Writeln('B. Courier');
Writeln('C. Helv');
Writeln('D. Tms Roman');
Writeln('E. Gothic');
Writeln('F. Prestige');
Read(Kbd,Choice);
Case Upcase(Choice) of
'A' : Write(Lst,Chr(27),'(8U',Chr(27),'(s0p16.66h8.5v0T');
'B' : Write(Lst,Chr(27),'(8U',Chr(27),'(s0p10h12v3T');
'C' : Write(Lst,Chr(27),'(0U',Chr(27),'(s1p14.4v4T');
'D' : Write(Lst,Chr(27),'(0U',Chr(27),'(s1p10v5T');
'E' : Write(Lst,Chr(27),'(8U',Chr(27),'(s0p12h12v6T');
'F' : Write(Lst,Chr(27),'(8U',Chr(27),'(s0p12h10v8T');
'G' : Write(^G);
'H' : Write(^G);
'I' : Write(^G);
'J' : Write(^G);
'K' : Write(^G);
'L' : Write(^G);
'M' : Write(^G);
'N' : Write(^G);
'O' : Write(^G);
'P' : Write(^G);
'Q' : Write(^G);
'R' : Write(^G);
'S' : Write(^G);
'T' : Write(^G);
'U' : Write(^G);
'V' : Write(^G);
'W' : Write(^G);
'X' : Write(^G);
'Y' : Write(^G);
'Z' : Write(^G);
End;
RmWin;
End;
Procedure DoWeight;
Begin
MkWin(10,3,35,8);
Writeln('A. Bold');
Writeln('B. Medium');
Writeln('C. Light');
Read(Kbd,Choice);
Case Upcase(Choice) of
'A' : Write(Lst,Chr(27),'(s4B');
'B' : Write(Lst,Chr(27),'(s0B');
'C' : Write(Lst,Chr(27),'(s-4B');
'D' : Write(^G);
'E' : Write(^G);
'F' : Write(^G);
'G' : Write(^G);
'H' : Write(^G);
'I' : Write(^G);
'J' : Write(^G);
'K' : Write(^G);
'L' : Write(^G);
'M' : Write(^G);
'N' : Write(^G);
'O' : Write(^G);
'P' : Write(^G);
'Q' : Write(^G);
'R' : Write(^G);
'S' : Write(^G);
'T' : Write(^G);
'U' : Write(^G);
'V' : Write(^G);
'W' : Write(^G);
'X' : Write(^G);
'Y' : Write(^G);
'Z' : Write(^G);
End;
RmWin;
End;
Procedure DoStyle;
Begin
MkWin(10,3,35,7);
Writeln('A. Upright ');
Writeln('B. Italic ');
Read(Kbd,Choice);
Case Upcase(Choice) of
'A' : Write(Lst,Chr(27),'(s0S');
'B' : Write(Lst,Chr(27),'(s1S');
'C' : Write(^G);
'D' : Write(^G);
'E' : Write(^G);
'F' : Write(^G);
'G' : Write(^G);
'H' : Write(^G);
'I' : Write(^G);
'J' : Write(^G);
'K' : Write(^G);
'L' : Write(^G);
'M' : Write(^G);
'N' : Write(^G);
'O' : Write(^G);
'P' : Write(^G);
'Q' : Write(^G);
'R' : Write(^G);
'S' : Write(^G);
'T' : Write(^G);
'U' : Write(^G);
'V' : Write(^G);
'W' : Write(^G);
'X' : Write(^G);
'Y' : Write(^G);
'Z' : Write(^G);
End;
RmWin;
End;
Procedure DoPaperSize;
Begin
MkWin(10,3,35,7);
Writeln('A. Regular');
Writeln('B. Legal');
Read(Kbd,Choice);
Case Upcase(Choice) of
'A' : Write(Lst,Chr(27),'&l66P');
'B' : Write(Lst,Chr(27),'&l84P');
'C' : Write(^G);
'D' : Write(^G);
'E' : Write(^G);
'F' : Write(^G);
'G' : Write(^G);
'H' : Write(^G);
'I' : Write(^G);
'J' : Write(^G);
'K' : Write(^G);
'L' : Write(^G);
'M' : Write(^G);
'N' : Write(^G);
'O' : Write(^G);
'P' : Write(^G);
'Q' : Write(^G);
'R' : Write(^G);
'S' : Write(^G);
'T' : Write(^G);
'U' : Write(^G);
'V' : Write(^G);
'W' : Write(^G);
'X' : Write(^G);
'Y' : Write(^G);
'Z' : Write(^G);
End;
RmWin;
End;
Procedure DoLPI;
Begin
MkWin(10,3,35,7);
Writeln('A. 6 LPI');
Writeln('B. 8 LPI');
Read(Kbd,Choice);
Case Upcase(Choice) of
'A' : Write(Lst,Chr(27),'&l6D');
'B' : Write(Lst,Chr(27),'&l8D');
'C' : Write(^G);
'D' : Write(^G);
'E' : Write(^G);
'F' : Write(^G);
'G' : Write(^G);
'H' : Write(^G);
'I' : Write(^G);
'J' : Write(^G);
'K' : Write(^G);
'L' : Write(^G);
'M' : Write(^G);
'N' : Write(^G);
'O' : Write(^G);
'P' : Write(^G);
'Q' : Write(^G);
'R' : Write(^G);
'S' : Write(^G);
'T' : Write(^G);
'U' : Write(^G);
'V' : Write(^G);
'W' : Write(^G);
'X' : Write(^G);
'Y' : Write(^G);
'Z' : Write(^G);
End;
RmWin;
End;
Procedure DoPaperInput;
Begin
MkWin(10,3,35,8);
Writeln('A. Eject current page');
Writeln('B. Cassette tray');
Writeln('C. Manual slot');
Read(Kbd,Choice);
Case Upcase(Choice) of
'A' : Write(Lst,Chr(27),'&l0H');
'B' : Write(Lst,Chr(27),'&l1H');
'C' : Write(Lst,Chr(27),'&l2H');
'D' : Write(^G);
'E' : Write(^G);
'F' : Write(^G);
'G' : Write(^G);
'H' : Write(^G);
'I' : Write(^G);
'J' : Write(^G);
'K' : Write(^G);
'L' : Write(^G);
'M' : Write(^G);
'N' : Write(^G);
'O' : Write(^G);
'P' : Write(^G);
'Q' : Write(^G);
'R' : Write(^G);
'S' : Write(^G);
'T' : Write(^G);
'U' : Write(^G);
'V' : Write(^G);
'W' : Write(^G);
'X' : Write(^G);
'Y' : Write(^G);
'Z' : Write(^G);
End;
RmWin;
End;
Procedure DoUnderLine;
Begin
MkWin(10,3,35,7);
Writeln('A. Turn on');
Writeln('B. Turn off');
Read(Kbd,Choice);
Case Upcase(Choice) of
'A' : Write(Lst,Chr(27),'&dD');
'B' : Write(Lst,Chr(27),'&d@');
'C' : Write(^G);
'D' : Write(^G);
'E' : Write(^G);
'F' : Write(^G);
'G' : Write(^G);
'H' : Write(^G);
'I' : Write(^G);
'J' : Write(^G);
'K' : Write(^G);
'L' : Write(^G);
'M' : Write(^G);
'N' : Write(^G);
'O' : Write(^G);
'P' : Write(^G);
'Q' : Write(^G);
'R' : Write(^G);
'S' : Write(^G);
'T' : Write(^G);
'U' : Write(^G);
'V' : Write(^G);
'W' : Write(^G);
'X' : Write(^G);
'Y' : Write(^G);
'Z' : Write(^G);
End;
RmWin;
End;
Procedure DoMargins;
Begin
MkWin(10,3,40,8);
TMarginStr := ''; LMarginStr := ''; RMarginStr := '';
TMargin := 2; LMargin := 0; RMargin := 240;
Write('Top Margin (2) : ');
GotoXY(30,4); Read(TMargin); Str(TMargin,TMarginStr); Writeln;
Write('Left Margin (0) : ');
GotoXY(30,5); Read(LMargin); Str(LMargin,LMarginStr); Writeln;
Write('Right Margin (240) : ');
GotoXY(30,6); Read(RMargin); Str(RMargin,RMarginStr);
TMarginStr := Chr(27) + '&l' + TMarginStr + 'E';
LMarginStr := Chr(27) + '&a' + LMarginStr + 'L';
RMarginStr := Chr(27) + '&a' + RMarginStr + 'M';
Write(Lst,TMarginStr);
Write(Lst,LMarginStr);
Write(Lst,RMarginStr);
RmWin;
End;
Procedure DoWrap;
Begin
MkWin(10,3,35,7);
Writeln('A. Turn on');
Writeln('B. Turn off');
Read(Kbd,Choice);
Case Upcase(Choice) of
'A' : Write(Lst,Chr(27),'&s0C');
'B' : Write(Lst,Chr(27),'&s1C');
'C' : Write(^G);
'D' : Write(^G);
'E' : Write(^G);
'F' : Write(^G);
'G' : Write(^G);
'H' : Write(^G);
'I' : Write(^G);
'J' : Write(^G);
'K' : Write(^G);
'L' : Write(^G);
'M' : Write(^G);
'N' : Write(^G);
'O' : Write(^G);
'P' : Write(^G);
'Q' : Write(^G);
'R' : Write(^G);
'S' : Write(^G);
'T' : Write(^G);
'U' : Write(^G);
'V' : Write(^G);
'W' : Write(^G);
'X' : Write(^G);
'Y' : Write(^G);
'Z' : Write(^G);
End;
RmWin;
End;
Procedure DoNoCopies;
Begin
MkWin(10,3,40,6); Copies := 1; CopiesStr := '';
Write('Number of copies (1-99) : '); Read(Copies); Str(Copies,CopiesStr);
CopiesStr := Chr(27) + '&l' + CopiesStr + 'X';
Write(Lst,CopiesStr);
RmWin;
End;
Procedure Lotus_I;
Begin
MkWin(10,3,58,12);
Writeln('A. Landscape/compressed, 176 col, 45 lines');
Writeln('B. Landscape/compressed, 176 col, 66 lines');
Writeln('C. Landscape/normal, 106 col, 45 lines');
Writeln('D. Landscape/normal, 106 col, 66 lines');
Writeln('E. Portrait /compressed, 132 col, 60 lines');
Writeln('F. Portrait /compressed, 132 col, 89 lines');
Writeln('G. Portrait /normal, 80 col, 66 lines');
Read(Kbd,Choice);
Case Upcase(Choice) of
'A' : Write(Lst,Chr(27),'&l1O',Chr(27),'&k2S');
'B' : Write(Lst,Chr(27),'&l1o2e5.647c66F',Chr(27),'&k2S');
'C' : Write(Lst,Chr(27),'&l1O');
'D' : Write(Lst,Chr(27),'&l1o2e5.647c66F');
'E' : Write(Lst,Chr(27),'&k2S');
'F' : Write(Lst,Chr(27),'&l2e5.647c89F',Chr(27),'&k2S');
'G' : Write(Lst,Chr(27),'&l14c1e7.64c66F');
'H' : Write(^G);
'I' : Write(^G);
'J' : Write(^G);
'K' : Write(^G);
'L' : Write(^G);
'M' : Write(^G);
'N' : Write(^G);
'O' : Write(^G);
'P' : Write(^G);
'Q' : Write(^G);
'R' : Write(^G);
'S' : Write(^G);
'T' : Write(^G);
'U' : Write(^G);
'V' : Write(^G);
'W' : Write(^G);
'X' : Write(^G);
'Y' : Write(^G);
'Z' : Write(^G);
End;
RmWin;
End;
Procedure Lotus_II;
Begin
MkWin(10,3,58,9);
Writeln('A. Landscape/compressed, 136 col, 45 lines');
Writeln('B. Landscape/compressed, 136 col, 66 lines');
Writeln('C. Landscape/normal, 136 col, 45 lines');
Writeln('D. Landscape/normal, 106 col, 66 lines');
Read(Kbd,Choice);
Case Upcase(Choice) of
'A' : Write(Lst,Chr(27),'&l84p1h1O',Chr(27),'&k2S');
'B' : Write(Lst,Chr(27),'&l84p1h1o2e5.647c66F',Chr(27),'&k2S');
'C' : Write(Lst,Chr(27),'&l84p1h1O');
'D' : Write(Lst,Chr(27),'&l84p1h1o2e5.647c66F');
'E' : Write(^G);
'F' : Write(^G);
'G' : Write(^G);
'H' : Write(^G);
'I' : Write(^G);
'J' : Write(^G);
'K' : Write(^G);
'L' : Write(^G);
'M' : Write(^G);
'N' : Write(^G);
'O' : Write(^G);
'P' : Write(^G);
'Q' : Write(^G);
'R' : Write(^G);
'S' : Write(^G);
'T' : Write(^G);
'U' : Write(^G);
'V' : Write(^G);
'W' : Write(^G);
'X' : Write(^G);
'Y' : Write(^G);
'Z' : Write(^G);
End;
RmWin;
End;
Begin
ClrScr; InitWin; Write(Lst,Chr(27),'E');
Writeln('╔═══════════════════════════════════════╗');
Writeln('║ tay! Temporary Beauty (release 2.0) ║');
Writeln('╠═══════════════════╦═══════════════════╣');
Writeln('║ A. Orientation ║ G. Paper Input ║');
Writeln('║ B. Type Face ║ H. Underline ║');
Writeln('║ C. Weight ║ I. Margins ║');
Writeln('║ D. Style ║ J. Wrap Lines ║');
Writeln('║ E. Paper Size ║ K. Number of ║');
Writeln('║ F. LPI ║ Copies ║');
Writeln('╠═══════════════════╩═══════════════════╣');
Writeln('║ L. Lotus Option I - Regular Size ║');
Writeln('║ M. Lotus Option II - Legal Size ║');
Writeln('╠═══════════════════════════════════════╣');
Writeln('║ R. Reset the Printer ║');
Writeln('║ <CTRL><F> Form Feed ║');
Writeln('╠═══════════════════════════════════════╣');
Writeln('║ Enter desired option (ESC to quit) ║');
Writeln('╚═══════════════════════════════════════╝');
Repeat
Repeat
GotoXY(WhereX,WhereY); Read(Kbd,Choice);
Until (Upcase(Choice) in ['A'..'R',#27]);
Case Upcase(Choice) of
'A' : DoOrientation;
'B' : DoTypeFace;
'C' : DoWeight;
'D' : DoStyle;
'E' : DoPaperSize;
'F' : DoLPI;
'G' : DoPaperInput;
'H' : DoUnderLine;
'I' : DoMargins;
'J' : DoWrap;
'K' : DoNoCopies;
'L' : Lotus_I;
'M' : Lotus_II;
'R' : Write(Lst,Chr(27),'E');
{ 'X' : Write(Lst,Chr(12)); }
End;
Until (Upcase(Choice) in [#27]);
End.